PsL Monthly 1993 December/PSL Monthly Shareware CD-ROM (December 1993).iso/prgmming/dos/pascal/iolog.com/IOLOG.PAS

Pascal/Delphi Source File | 1988-12-20 | 16.7 KB | 538 lines

{
 IOLOG - a TSR that logs all DOS disk I/O operations to a file for later
 study.

 To install, type
   IOLOG [LogFileName]

 The log file defaults to C:\IOLOG. This file is rewritten when the TSR goes
 resident. If you use a different file, be sure to specify a complete path
 name, since IOLOG opens and closes this file for each I/O operation. If you
 haven't specified a complete path name and you change directories, you'll get
 little log files scattered all over the place.

 The log file is a text file showing information about each interesting DOS
 I/O call. It lists the call and then the associated file handle or name, as
 available. If DOS detected an error during the call, column 9 of the report
 shows an asterisk, unless reporting of failed calls is disabled. IOLOG does
 not log its own I/O operations.

 IOLOG uses a buffer to hold log information until it is safe to write it to
 disk. In the unexpected event that the buffer overflows before it can be
 emptied, the log file will contain one or more lines showing just an
 exclamation point.

 Certain aspects of IOLOG can be controlled by pressing hot keys after it has
 gone resident. The following table summarizes the hot keys:

   <LeftShift><RightShift><L>     toggles logging            (default ON)
   <LeftShift><RightShift><W>     toggles read/write logging (default OFF)
   <LeftShift><RightShift><F>     toggles failure logging    (default ON)
   <LeftShift><RightShift><C>     clears log file
   <LeftShift><RightShift><U>     unloads IOLOG from memory

 When logging is off, no further I/O operations will be logged until it is
 turned on again. Then any new operations will be appended to the existing log
 file. The Read/Write toggle controls whether DOS functions $3F and $40 are
 logged. In some cases, these calls are made quite often, and logging them
 will both decimate the performance of any program that is running and also
 create huge log files. The Failure toggle controls whether DOS calls with
 errors are reported, e.g., a request to open a file that isn't found. If
 failures are logged, they are denoted by an asterisk in column 9 of the log.
 Otherwise, failing calls do not appear at all.

 IOLOG uses sound effects to let you know whether you're toggling a feature on
 or off. When you toggle something ON, a rising sequence of tones sounds. OFF,
 and a falling sequence is used. When you clear the log file, you get a muddy
 sounding warble. And "taps" plays when you successfully unload IOLOG from
 memory.

 IOLOG uses about 19K of memory while installed.

 Requires Turbo Professional to compile.
 Released to the public domain.

 Written by Kim Kokkonen, TurboPower Software
 Thanks to Don Pearsall for providing the impetus to write this program.

 Version 1.0 - 12/16/88
   initial release
}

{$R-,V-,S-,B-,I-}                 {Turn off all the checking}
{$M 1024,100,100}                 {Small stack, no heap}

{WARNING: this program has been carefully optimized to use small stacks
 like the 1024 byte main program stack above. Do not modify this program or
 use it as a model for other TSRs without checking out the stack usage first}

program IOLog;

uses
  Dos, TpInt, TpTsr;              {TPINT and TPTSR are from Turbo Professional}

const
  TimerHandle = 15;               {ISR handle for int 1C}
  DosHandle = 16;                 {ISR handle for int 21}
  LogBufSize = 1024;              {Bytes in log buffer}
  ToggleLogKey = $0326;           {Toggle logging       - <LShift><RShift><L>}
  ClearLogKey = $032E;            {Clear log file       - <LShift><RShift><C>}
  RWLogKey = $0311;               {Log read/write calls - <LShift><RShift><W>}
  FailLogKey = $0321;             {Toggle fail reports  - <LShift><RShift><F>}
  UnloadKey = $0316;              {Unload logger        - <LShift><RShift><U>}

var
  LogFileName : string[63];       {Name chosen for log file}
  LogFile : file;                 {Untyped log file}
  LogBuffer : array[1..LogBufSize] of Char; {Temporarily stores log info}
  LogBufPos : Word;               {Next available position in log buffer}
  LogString : string[99];         {Temporary string to build log transaction}

  LogChangeHandle : Byte;         {SetPopTicker handler for log to disk routine}
  DosStack : array[1..1024] of Byte; {Stack used by int 21 handler}
  HotStack : array[1..512] of Byte; {Stack used by hotkey popups}

  AccessingLogFile : Boolean;     {True while logging to disk}
  BufferingLogInfo : Boolean;     {True while int 21 handler active}
  LoggingIsActive : Boolean;      {True while we're gathering log info}
  LoggingReadWrite : Boolean;     {True to log read/write calls}
  ShowFailures : Boolean;         {True to show failing IO calls}

  CountsPerMs : Word;             {Tight loop count for one millisecond}



  procedure Delay(Ms : Word);
    {-Delay for specified number of milliseconds}
  var
    DummyLow : Word absolute $0 : $0;
    InitTicks : Word;
    Counts : Word;
    Done : Boolean;
    T : Word;
  begin
    for T := 1 to Ms do begin
      InitTicks := DummyLow;
      Counts := 0;
      repeat
        Inc(Counts);
        Done := (Counts = CountsPerMs) or (DummyLow <> InitTicks);
      until Done;
    end;
  end;

  procedure CalibrateDelay;
    {-Delay calibration routine, similar to CRT unit}
  var
    BiosTickLow : Word absolute $40 : $6C; {BIOS timer data}
    InitTicks : Word;
    Counts : Word;
    Done : Boolean;
  begin
    InterruptsOn;
    CountsPerMs := 50000;          {Upper limit for counts per tick}

    {Wait for tick to change}
    InitTicks := BiosTickLow;
    repeat
    until BiosTickLow <> InitTicks;

    {Now count until it changes again or it reaches a limit}
    InitTicks := BiosTickLow;
    Counts := 0;
    repeat
      Inc(Counts);
      Done := (Counts = CountsPerMs) or (BiosTickLow <> InitTicks);
    until Done;

    {Convert to counts per millisecond}
    CountsPerMs := Counts div 55;
  end;

  procedure Sound(Freq : Word);
    {-Activate speaker at specified frequency}
  var
    Count : Word;
    SoundPort : Byte;
  begin
    Count := $1234DC div Freq;
    SoundPort := Port[$61];
    Port[$61] := SoundPort or 3;  {Program sound port}
    Port[$43] := $B6;             {Tell timer a count is coming}
    Port[$42] := Lo(Count);
    Port[$42] := Hi(Count);
  end;

  procedure NoSound;
    {-Deactivate sound}
  var
    SoundPort : Byte;
  begin
    SoundPort := Port[$61];
    Port[$61] := SoundPort and $FC;
  end;

  procedure Note(Freq, Dura : Word);
    {-Sound a note}
  begin
    Sound(Freq);
    Delay(Dura);
    NoSound;
  end;

  procedure UpSound;
    {-Rising tones}
  var
    F : Word;
  begin
    for F := 2 to 12 do
      Note(F*200, 50);
  end;

  procedure DownSound;
    {-Falling tones}
  var
    F : Word;
  begin
    for F := 12 downto 2 do
      Note(F*200, 50);
  end;

  procedure MuddySound;
    {-Sound made when deleting file}
  var
    F : Word;
    G : Word;
  begin
    for F := 1 to 5 do begin
      Sound(100);
      Delay(100);
      for G := 10 to 20 do begin
        Sound(G*100);
        Delay(10);
      end;
    end;
    NoSound;
  end;

  procedure SaluteSound;
    {-Sound made when unloading TSR}
  begin
    Note(400, 150);
    Delay(50);
    Note(400, 50);
    Delay(50);
    Note(550, 700);
    Delay(50);

    Note(400, 150);
    Delay(50);
    Note(550, 50);
    Delay(50);
    Note(700, 700);
  end;

  procedure StUpcaseVar(var S : string);
    {-Raise string to uppercase}
  var
    I : Integer;
  begin
    for I := 1 to Length(S) do
      S[I] := UpCase(S[I]);
  end;

  procedure GetFileName(var Regs : IntRegisters);
    {-Convert ASCIIZ string at DS:DX to a Turbo string}
  type
    Carray = array[0..100] of Char;
  var
    Cptr : ^Carray;
    Len : Word;
  begin
    Cptr := Ptr(Regs.Ds, Regs.Dx);
    Len := 0;
    while (Len < 79) and (Cptr^[Len] <> #0) do begin
      Inc(Len);
      LogString[Len] := UpCase(Cptr^[Len-1]);
    end;
    LogString[0] := Char(Len);
  end;

  procedure LogToBuffer;
    {-Add the latest LogString to the end of the buffer, or show overflow}
  const
    CrLf : string[2] = ^M^J;      {Terminates each line in log file}
    Overflow = '!';               {String written to show buffer overflow}
  begin
    AccessingLogFile := True;
    if LogBufPos+Length(LogString)+3 <= LogBufSize then begin
      {Fits in buffer, with room for an overflow marker still}
      Move(LogString[1], LogBuffer[LogBufPos], Length(LogString));
      Inc(LogBufPos, Length(LogString));
      Move(CrLf[1], LogBuffer[LogBufPos], 2);
      Inc(LogBufPos, 2);
    end else if LogBufPos+2 <= LogBufSize then begin
      {Overflow marker fits in buffer}
      LogBuffer[LogBufPos] := Overflow;
      Inc(LogBufPos);
      Move(CrLf[1], LogBuffer[LogBufPos], 2);
      Inc(LogBufPos, 2);
    end;
    AccessingLogFile := False;
  end;

  procedure ToggleFlag(var Flag : Boolean);
    {-Toggle any log flag}
  begin
    PopupsOff;
    Flag := not Flag;
    {Make a sound}
    if Flag then
      UpSound
    else
      DownSound;
    PopupsOn;
  end;

  {$F+}
  procedure WriteLogFile(var Regs : Registers);
    {-Called via SetPopTicker to update log file}
  var
    ErrorCode : Word;
  begin
    AccessingLogFile := True;
    Assign(LogFile, LogFileName);
    Reset(LogFile, 1);
    if IoResult = 0 then
      Seek(LogFile, FileSize(LogFile))
    else
      Rewrite(LogFile, 1);
    if IoResult = 0 then begin
      BlockWrite(LogFile, LogBuffer, LogBufPos-1);
      Close(LogFile);
      ErrorCode := IoResult;
    end;
    LogBufPos := 1;
    AccessingLogFile := False;
  end;

  procedure ToggleLogging(var Regs : Registers);
    {-Toggle logging - activated by <LShift><RShift><L>}
  begin
    ToggleFlag(LoggingIsActive);
  end;

  procedure ToggleRW(var Regs : Registers);
    {-Toggle logging of read/write calls - activated by <LShift><RShift><W>}
  begin
    ToggleFlag(LoggingReadWrite);
  end;

  procedure ToggleFail(var Regs : Registers);
    {-Toggle logging of failed calls - activated by <LShift><RShift><F>}
  begin
    ToggleFlag(ShowFailures);
  end;

  procedure ClearLog(var Regs : Registers);
    {-Clear the current log file - activated by <LShift><RShift><C>}
  var
    ErrorCode : Word;
  begin
    PopupsOff;
    AccessingLogFile := True;
    Assign(LogFile, LogFileName);
    Rewrite(LogFile, 1);
    if IoResult = 0 then begin
      Close(LogFile);
      ErrorCode := IoResult;
      {Make a sound}
      MuddySound;
    end;
    LogBufPos := 1;
    AccessingLogFile := False;
    PopupsOn;
  end;

  procedure Unload(var Regs : Registers);
    {-Unload from memory - activated by <LShift><RShift><U>}
  begin
    if DisableTSR then
      SaluteSound;
  end;

  procedure TimerMonitor(BP : Word); interrupt;
    {-ISR called on every int 1C}
  var
    Regs : IntRegisters absolute BP;
  begin
    EmulateInt(Regs, ISR_Array[TimerHandle].OrigAddr);
    if (LogBufPos > 1) and not AccessingLogFile then
      SetPopTicker(LogChangeHandle, 18);
  end;

  procedure DosHandler(var Regs : IntRegisters);
    {-Called during int 21 to buffer log strings}
  const
    OpenName : array[$3C..$3D] of string[10] = ('create    ', 'open      ');
    DupName : array[$45..$46] of string[10] = ('dup       ', 'cdup      ');
    ChModName : array[0..1] of string[13] = ('get mode     ', 'set mode     ');
    DateName : array[0..1] of string[10] = ('get date  ', 'set date  ');
    CloseName : string[10] = 'close     ';
    DeleteName : string[13] = 'delete       ';
    FindName : string[13] = 'findfile     ';
    RenameName : string[13] = 'rename       ';
    ReadName : string[10] = 'read      ';
    WriteName : string[10] = 'write     ';
  var
    CallAH : Byte;
    CallAL : Byte;
    HandleString : string[5];
  begin
    with Regs do begin
      {Save a few items we may need later}
      CallAH := AH;
      CallAL := AL;
      Str(BX:2, HandleString);

      {Save the filename when available}
      case CallAH of
        $3C, $3D, $41, $43, $4E, $56 : GetFileName(Regs);
      end;

      {Call DOS to do the real work}
      EmulateInt(Regs, ISR_Array[DosHandle].OrigAddr);

      {Save the rest of the info}
      case CallAH of
        $3C..$3D :                {Opening or creating a file}
          begin
            if Odd(Flags) then
              HandleString := '  '
            else
              Str(AX:2, HandleString);
            LogString := ' '+LogString;
            LogString := HandleString+LogString;
            LogString := OpenName[CallAH]+LogString;
          end;
        $3E :                     {Closing a file}
          LogString := CloseName+HandleString;
        $3F :                     {Read file}
          LogString := ReadName+HandleString;
        $40 :                     {Write file}
          LogString := WriteName+HandleString;
        $41 :                     {Erasing a file}
          LogString := DeleteName+LogString;
        $43 :                     {Get or set attribute}
          LogString := ChModName[CallAL]+LogString;
        $45, $46 :                {Dup handle}
          LogString := DupName[CallAH]+HandleString;
        $4E :                     {Find first}
          LogString := FindName+LogString;
        $56 :                     {Rename}
          LogString := RenameName+LogString;
        $57 :                     {Date/time}
          LogString := DateName[CallAL]+HandleString;
      else
        Exit;                     {Shouldn't get here, protect just in case}
      end;

      if Odd(Flags) then
        if ShowFailures then
          {Indicate an error in the call}
          LogString[9] := '*'
        else
          Exit;

      {Store the string in the buffer}
      LogToBuffer;
    end;
  end;

  procedure DosMonitor(BP : Word); interrupt;
    {-ISR called on every int 21}
  var
    Regs : IntRegisters absolute BP;
    LogThisCall : Boolean;
  begin
    if not LoggingIsActive or AccessingLogFile or BufferingLogInfo then
      {Don't log our own log operations or overwrite swap stack}
      LogThisCall := False
    else
      case Regs.AH of
        $3F, $40 : LogThisCall := LoggingReadWrite;
        $3C..$3E, $41, $43, $45..$46, $4E, $56..$57 : LogThisCall := True;
      else
        LogThisCall := False;
      end;

    if LogThisCall then begin
      BufferingLogInfo := True;
      SwapStackAndCall(@DosHandler, @DosStack[SizeOf(DosStack)], Regs);
      BufferingLogInfo := False;
    end else
      ChainInt(Regs, ISR_Array[DosHandle].OrigAddr)
  end;
  {$F-}

  procedure Abort(Msg : string);
    {-Write a message and halt}
  begin
    WriteLn(Msg);
    Halt(1);
  end;

begin
  {Create the log file}
  if ParamCount > 0 then
    LogFileName := ParamStr(1)
  else
    LogFileName := 'C:\IOLOG';
  StUpcaseVar(LogFileName);
  Assign(LogFile, LogFileName);
  Rewrite(LogFile, 1);
  if IoResult <> 0 then begin
    WriteLn('Could not create ', LogFileName);
    Abort('Usage: IOLOG [LogFileName]');
  end;
  Close(LogFile);

  {Initialize global variables}
  CalibrateDelay;
  LogBufPos := 1;
  AccessingLogFile := False;
  BufferingLogInfo := False;

  {These flags control IOLOG's behavior}
  LoggingIsActive := True;
  LoggingReadWrite := False;
  ShowFailures := True;

  {Grab interrupt vectors and set up hot keys}
  if
  not InitVector($1C, TimerHandle, @TimerMonitor) or
  not InitVector($21, DosHandle, @DosMonitor) or
  not DefinePopProc(LogChangeHandle, @WriteLogFile, Ptr(SSeg, SPtr)) or
  not DefinePop(ToggleLogKey, @ToggleLogging, @HotStack[SizeOf(HotStack)], True) or
  not DefinePop(ClearLogKey, @ClearLog, @HotStack[SizeOf(HotStack)], True) or
  not DefinePop(RWLogKey, @ToggleRW, @HotStack[SizeOf(HotStack)], True) or
  not DefinePop(FailLogKey, @ToggleFail, @HotStack[SizeOf(HotStack)], True) or
  not DefinePop(UnloadKey, @Unload, @HotStack[SizeOf(HotStack)], True)
  then
    Abort('Unable to install IOLOG');

  WriteLn('IOLOG 1.0  -- by TurboPower Software -- DOS File Logging');
  WriteLn('  <LeftShift><RightShift><L> toggles logging            (default ON)');
  WriteLn('  <LeftShift><RightShift><W> toggles read/write logging (default OFF)');
  WriteLn('  <LeftShift><RightShift><F> toggles failure logging    (default ON)');
  WriteLn('  <LeftShift><RightShift><C> clears log file');
  WriteLn('  <LeftShift><RightShift><U> unloads IOLOG from memory');
  WriteLn;
  WriteLn('Logging results to ', LogFileName);

  {Activate popups and go resident}
  PopupsOn;
  if not TerminateAndStayResident(ParagraphsToKeep, 0) then
    Abort('Unable to go resident');
end.